home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MATH / MATH1 / SOLVGJ2.PAS < prev    next >
Pascal/Delphi Source File  |  1985-04-03  |  2KB  |  110 lines
  1. program solvgj2;        { -> 111 }
  2. { pascal program to perform simultaneous solution by Gauss-Jordan elimination}
  3. { there may be more equations than unknowns }
  4.  
  5. const    maxr    = 8;
  6.     maxc    = 8;
  7.  
  8. type    ary    = array[1..maxr] of real;
  9.     arys    = array[1..maxc] of real;
  10.     ary2s    = array[1..maxr,1..maxc] of real;
  11.     ary2    = ary2s;    { for square }
  12.  
  13. var    y    : ary;
  14.     coef,yy    : arys;
  15.     a,b    : ary2s;
  16.     n,m,i,j    : integer;
  17.     first,
  18.     error    : boolean;
  19.  
  20. external procedure cls;
  21.  
  22. procedure get_data(var a: ary2s;
  23.            var y: ary;
  24.            var n,m: integer);
  25.  
  26. { get the values for n and arrays a,y }
  27.  
  28. var    i,j    : integer;
  29.  
  30. begin
  31.   writeln;
  32.   repeat
  33.     write('How many unknowns? ');
  34.     readln(m);
  35.     if first then first:=false else cls;
  36.   until m<maxc;
  37.   if m>1 then
  38.     begin
  39.       repeat
  40.     write('How many equations? ');
  41.     readln(n)
  42.       until n>=m;
  43.     for i:=1 to n do
  44.     begin
  45.       writeln('Equation',i:3);
  46.       for j:=1 to m do
  47.         begin
  48.           write(j:3,':');
  49.           read(a[i,j])
  50.         end;
  51.       write(',C:');
  52.       readln(y[i])    { clear line }
  53.     end;    { i-loop }
  54.       writeln;
  55.       for i:=1 to n do
  56.     begin
  57.       for j:=1 to m do
  58.         write(a[i,j]:7:4,' ');
  59.       writeln(':',y[i]:7:4)
  60.     end;
  61.       writeln
  62.     end        { if n>1 }
  63. end;    { procedure get_data }
  64.  
  65. procedure write_data;
  66.  
  67. { print out the answers }
  68.  
  69. var    i    : integer;
  70.  
  71. begin
  72.   for i:=1 to m do
  73.     write(coef[i]:9:5);
  74.   writeln
  75. end;    { write_data }
  76.  
  77. {external procedure square
  78.  (        y : ary;
  79.   var        a : ary2s;
  80.   var        g : arys;
  81.     nrow,ncol : integer);}
  82.  
  83. {$I C:SQUARE.LIB}
  84.  
  85. {external procedure gaussj
  86.  (var        b : ary2s;
  87.         y : arys;
  88.   var         coef : arys;
  89.          ncol : integer;
  90.   var        error : boolean);}
  91.  
  92. {$I C:GAUSSJ.LIB}
  93.  
  94. begin        { MAIN program }
  95.   first:=true;
  96.   cls;
  97.   writeln;
  98.   writeln('Best fit to simultaneous equations');
  99.   writeln('By Gauss-Jordan');
  100.   repeat
  101.     get_data(a,y,n,m);
  102.     if m>1 then
  103.       begin
  104.     square(a,y,b,yy,n,m);
  105.     gaussj(b,yy,coef,m,error);
  106.     if not error then write_data
  107.       end
  108.   until m<2
  109. end.
  110.